home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / SHELLS / SHELL / SHELSORT.PAS < prev   
Pascal/Delphi Source File  |  1986-08-30  |  10KB  |  247 lines
  1. (*
  2. This program demonstrates the use of the assembly language implemention
  3. of the Shell-Metzner sort algorithm.  The shell sort is ideally suited
  4. for sorting Pascal data structures for three reasons:
  5.  
  6.            1. It is much(!) faster than a bubble sort
  7.            2. Unlike a quick sort, it is even faster if
  8.               the data are partially ordered.
  9.            3. It is relatively simple to implement in
  10.               8086/8088 assembly language.
  11.  
  12. Sort times will depend primarily upon three main factors:
  13.  
  14.            1. Length of the key sort field.
  15.            2. Size of the record structure.
  16.            3. Number of records in the structure.
  17.  
  18. This routine has been developed so that a user may use it to sort any (well,
  19. almost any!) size array of Turbo Pascal records.  The records can be of any
  20. desirable structure but the key field must be a string, char array, or byte
  21. type.  Integers are stored internally with the LSB first, so this routine
  22. will not properly sort on an integer field.  The routine is modifiable,
  23. however, and may be adapted to sort on integers or even reals.  If it is
  24. desired to use a string type as a key field, two things are important to
  25. note.  First, initialize the array with zeros before filling the array so
  26. that the unused field slots are all the same for a proper comparison.  The
  27. Turbo FILLCHAR(A,SIZEOF(X),0) procedure is best for this.  Second, be sure
  28. to increment the offset of the key field by one to set the pointers at the
  29. first character of the string and not at the string length byte.  This
  30. program illustrates how string fields are properly set up and sorted.
  31.  
  32. The routine uses the parametric values of the key field location and length
  33. and the record size to compare fields in accordance with the shell algorithm
  34. and then exchange records based upon the comparison.  It might be speeded up
  35. a hair with more efficient register utilization, but I doubt it.  If anyone
  36. does speed it up significantly, I'd appreciate knowing about it.  By the
  37. way, the times below were derived on a Leading Edge Model "M" running at
  38. 8 Mhz and are accordingly less than will be realized on a stock PC.
  39.  
  40. For those desiring to implement this routine in Turbo inline code, I strongly
  41. suggest you get a copy of David Baldwin's outstanding(!!!) inline assembler
  42. (located in DL1) and modify the MASM code in the routine to assemble to
  43. inline code (but get rid of the underscores, Baldwin's assembler chokes on
  44. them).
  45.  
  46. COPYRIGHT (C) 1986 by John J. Newlin.  The 8086/8088 assembly code and
  47. Turbo Pascal code supplied here is intended for the private use of those
  48. acquiring it.  It may be freely copied and distributed but it may not be
  49. utilized in any IBM PC software marketed for profit.  Direct questions,
  50. comments, or complaints to me at 71535,665 on CIS.
  51.  
  52.  
  53. =========================SHELL SORT ROUTINE================================
  54.  
  55. ;Assemble to SHELSORT.EXE, then use EXE2BIN to convert to .COM file
  56. ;declare in TURBO PASCAL source file as below
  57.  
  58. ;procedure shellsort(len,field,entries,size:integer; var struc);
  59.  
  60. ;len     = the length of the key (sort) field
  61. ;field   = offset of the field within the record (add 1 for string fields)
  62. ;entries = number of records in the array
  63. ;struc   = the declared name of the array
  64.  
  65. code         segment
  66.              assume cs:code
  67.  
  68. ;use equates to keep things straight
  69.  
  70. STRUC        equ [bp+4]
  71. SIZE         equ [bp+8]
  72. ENTRIES      equ [bp+10]
  73. FIELD        equ [bp+12]
  74. LEN          equ [bp+14]
  75. N            equ [bp-2]
  76. JUMP         equ [bp-4]
  77. N_JUMP       equ [bp-6]
  78.  
  79.  
  80. sort:        push bp                ;save bp
  81.              mov bp,sp              ;reference the stack with bp
  82.              sub sp,10              ;make some working space for local vars
  83.              push ds                ;preserve ds
  84.              push es                ;and es as well (although not necessary)
  85.              les di,STRUC           ;load es with struc seg - di with struc ofs
  86.              lds si,STRUC           ;same with ds
  87.              jmp sortem             ;goto main body
  88.  
  89. compare:     push si                ;save the pointers
  90.              push di
  91.              push cx                ;save the counter
  92.              mov cx,LEN             ;no of bytes to scan
  93.              add si,word ptr FIELD  ;bump si by key field length
  94.              add di,word ptr FIELD  ;bump di by key field length
  95.              repz cmpsb             ;compare em!
  96.              pop cx                 ;flag will be set accordingly
  97.              pop di                 ;restore regs
  98.              pop si
  99.              ret                    ;and return
  100.  
  101. swap:        push si                ;save the pointers
  102.              push di
  103.              push cx                ;save the counter
  104.              push ax                ;will use ax, so save it
  105.              cld                    ;move is forward
  106. again1:      mov al,byte ptr[di]    ;save one byte
  107.              movsb                  ;move one bye
  108.              mov byte ptr es:[si-1],al ;move saved byte
  109.              loop again1            ;continue for length of record
  110.              pop ax                 ;restore regs
  111.              pop cx
  112.              pop di
  113.              pop si
  114.              ret                    ;and return
  115.  
  116. sortem:      mov cx,ENTRIES         ;no. of entries
  117.              mov dx,SIZE            ;size of record
  118.              mov N,cx               ;store N
  119.              mov JUMP,cx            ;store JUMP (JUMP = N)
  120.              dec word ptr N         ;N = N - 1
  121.  
  122. loop1:       cmp word ptr JUMP,1    ;is JUMP > 1?
  123.              jbe exit               ;no - sort complete
  124.              shr word ptr JUMP,1    ;JUMP = JUMP DIV 2
  125.  
  126. loop2:       mov bl,1               ;set DONE = TRUE
  127.              mov ax,N               ;get N
  128.              sub ax,word ptr JUMP   ;compute N - JUMP
  129.              mov N_JUMP,ax          ;store N - JUMP
  130.              mov cx,0
  131.                                     ;for J = 1 to N - JUMP DO
  132. loop3:       push si                ;save pointer to record
  133.              push di                ;save pointer to record
  134.              mov ax,SIZE            ;get rec size
  135.              mul cx                 ;multipy by J
  136.              add si,ax              ;j = si, so a[j] = a[si]
  137.              mov ax,SIZE            ;get rec size
  138.              mul word ptr JUMP      ;multiply by JUMP
  139.              add ax,si              ;offset from si (j)
  140.              mov di,ax              ;i = di, so a[i] = a[di]
  141.              call compare           ;compare fields
  142.              jbe no_swap            ;no swap
  143.              push cx                ;save loop counter
  144.              mov cx,SIZE            ;SWAP needs size of record
  145.              call swap              ;do it!
  146.              pop cx                 ;restore loop counter
  147.              mov bl,0               ;set DONE = FALSE
  148. no_swap:     cmp cx,word ptr N_JUMP ;is cx = N - JUMP?
  149.              pop di                 ;restore pointer
  150.              pop si                 ;restore pointer
  151.              inc cx                 ;bump the counter
  152.              jb loop3               ;if cycle not complete, go again
  153.              cmp bl,0               ;is DONE = FALSE
  154.              je loop2               ;no, another cycle
  155.              jmp loop1              ;keep going until sort is complete
  156. exit:        pop es                 ;restore es reg
  157.              pop ds                 ;restore ds reg
  158.              mov sp,bp              ;restore original sp
  159.              pop bp                 ;restore original bp
  160.              ret 12                 ;clean up stack for TURBO
  161. code         ends
  162.              end sort
  163.  
  164.  
  165.  
  166. =====================SORT DEMONSTRATION PROGRAM=============================
  167. *)
  168.  
  169. {$U+}
  170. const
  171.   recs = 15;  {CHANGE THIS VALUE AS DESIRED}
  172. (*  SORT PERFORMANCE USING A 12 BYTE KEY FIELD IN A 24 BYTE RECORD
  173.  
  174.     NO. RECS                 BUBBLE           SHELL
  175.     --------                ---------        --------
  176.       50                     00:00.50        00:00.17
  177.      100                     00:01.00        00:00.49
  178.      150                     00:04.00        00:00.77
  179.      200                     00:05.00        00:01.16
  180.      250                     00:08.00        00:01.59
  181.      300                     00:12.00        00:01.86
  182.      350                     00:17.00        00:02.09
  183.      400                     00:22.00        00:03.18
  184.      500                     00:33.00        00:03.79
  185.      750                     01:15.00        00:06.00
  186.     1000                     02:15.00        00:08.79
  187.  
  188. Note: the bubble sort used for this test was also an assembly language
  189.       routine.
  190. *)
  191.  
  192. type
  193.    Regtype     = record Ax,Bx,Cx,Dx,Bp,Si,Di,Ds,Es,Flags:integer  end;
  194.    a_type = string[12];
  195.    x_type = record
  196.               a : integer;
  197.               b : a_type;
  198.               c : integer;
  199.               d : byte;
  200.               e : array[1..6] of byte;
  201.              end;
  202.    str12 = string[8];
  203.  
  204. var
  205.   rgs : regtype;
  206.   x : x_type;
  207.   i,j,n : integer;
  208.   temp : a_type;
  209.   k,ch : char;
  210.   a : array[1..recs] of x_type;
  211.  
  212. function time : str12;
  213. var
  214.   m,h,x,s,timestr : str12;
  215.   i : integer;
  216. begin
  217.   rgs.ax := $2C00;
  218.   msdos(rgs);
  219.   str(lo(rgs.cx):2,m);
  220.   str(hi(rgs.dx):2,s);
  221.   str(lo(rgs.dx):2,h);
  222.   timestr := m + ':' + s + '.' + h;
  223.   for i := 1 to 8 do if timestr[i] = #32 then timestr[i] := '0';
  224.   time := timestr;
  225. end;
  226.  
  227. procedure shellsort(len,field,entries,size:integer; var struc);
  228. external 'shelsort.bin';
  229.  
  230. begin
  231.   fillchar(a,sizeof(a),0);
  232.   for i := 1 to recs do
  233.     begin
  234.       n := random(11) + 1;
  235.       temp[0] := chr(n);
  236.       for j := 1 to n do temp[j] := chr(random(26) + 65);
  237.       a[i].b := temp;
  238.       a[i].a := i;
  239.     end;
  240.   writeln('STARTED SORT',^g);
  241.   writeln(time);
  242.   shellsort(12,3,recs,sizeof(x_type),a);
  243.   writeln(time);
  244.   writeln('ENDED SORT',^g);
  245.   for i := 1 to 15 do  writeln(a[i].b); {REMOVE, IF DESIRED, FOR LONGER SORTS}
  246. end.
  247.